perm filename CREDPY[CRE,BGB] blob sn#106834 filedate 1974-06-17 generic text, type C, neo UTF8
COMMENT ⊗   VALID 00016 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00003 00002	TITLE CREDPY  -  CRE DISPLAY ROUTINES  -  BGB  -  16 APRIL 1973.
C00005 00003	III DISPLAY ROUTINES.
C00007 00004	------------------------------------------------------------------------------
C00011 00005		EXTERN BLKCNT,VCUT,HISTO,FILM,HISTOG
C00013 00006	AI(X,Y). AV(X,Y).
C00015 00007	CLIP(X1,Y1,X2,Y2).	2D CLIPPER.
C00018 00008		2D CLIPPER continued.
C00020 00009	SUBR(STADPY).		STATUS DISPLAY.
C00022 00010	SUBR(DPYIMG)IMG		DISPLAY AN IMAGE.
C00024 00011	SUBR(ID)	IDENTIFIER DISPLAY - BGB - 13 DEC 1972.
C00026 00012	SUBR(OD)	OCTAL DISPLAY HALF WORD DISPLAY.
C00028 00013	SUBR(DPYBLK)NODE.		DISPLAY CONTENTS OF A NODE.
C00031 00014	SUBR(TIMDPY)PGON	DISPLAY A POLYGON'S TIME SUCCESSOR.
C00033 00015	SUBR(DPYHIS)		DISPLAY HISTOGRAM.
C00036 00016	SUBR(DPYGON)PGON	DISPLAY POLYGON.
C00037 ENDMK
C⊗;
TITLE CREDPY  -  CRE DISPLAY ROUTINES  -  BGB  -  16 APRIL 1973.
	.INSERT MNCRE
	EXTERN FLGIII,FLGDD
	INTERN SX,SY,MAG,DEL

	INTEGER SX,SY,SOX,SOY	;SOURCE WINDOW.
	INTEGER OX,OY		;OBJECT WINDOW.
	INTEGER XL,XH,YL,YH	;DISPLAY WINDOW.
	INTEGER XXX,YYY		;PSEUDO BEAM POSITION.

	MAG: 3.5↔DEL: 32.0

SUBR(PLOTO)		;PLOT FILE OUTPUT
BEGIN PLOTO;-------------------------------------------------------------------
	CALL(GETFIL↑,[SIXBIT/PLT/],[0])↔JFCL
	SKIPN GETFIL-4↔POP0J			;ABORT WHEN NO FILENAME.

	LAC 1,BEGBUF
	LAC SIZBUF↔DAC -1(1)			;NUMBER OF WORDS IN DISPLAY.
	ADDI 2↔TRNE 1↔AOS
	MOVN↔MOVS				;NUMBER OF WORDS IN PLT FILE.
	HRRI -3(1)↔DAC DUMLST			;IOWD FOR DUMP,

	INIT 1,17↔SIXBIT/DSK/↔0↔HALT
	ENTER 1,GETFIL-4↔GO .+4			;FILENAME.
	OUT 1,DUMLST↔JFCL
	OUTSTR[ASCIZ"	EOF.
"]↔	RELEASE 1,↔POP0J
DUMLST: 0↔0
BEND PLOTO;BGB 10 DECEMBER 1974 -----------------------------------------------

SUBR(DPYSST)SAISTR	;DISPLAY SAIL STRING.
BEGIN DPYSST;------------------------------------------------------------------
	POP 16,1↔POP 16,2	;STRING BYTE POINTER & LENGTH.
	HRRZS 2↔JUMPLE 2,.+4
	ILDB 1↔CALL(DTYO,0)
	SOJG 2,.-3↔POP0J
BEND DPYSST;-------------------------------------------------------------------
;III DISPLAY ROUTINES.
	DECLARE{IGNORE,DPYPTR,SIZBRT}
	DECLARE{BEGBUF,SIZBUF,ENDBUF}
	DPYBUF↑: .+2↔=3500↔BLOCK =3510

SUBR(DPYSET)
	LAC 1,ARG1↔DZM(1)			;PLOT FILE'S FIRST WORD.
	CDR -1(1)↔SUBI 3↔DAC SIZBUF		;SIZE OF BUFFER.
	ADDI 1,2↔DAC 1,BEGBUF↔DZM(1)		;UPGIOT FIRST WORD OF BUFFER.
	HRLI 1,440700↔DAC 1,DPYPTR		;DPYBUF TEXT POINTER.
	LAC BEGBUF↔ADD SIZBUF↔SOS↔DAC ENDBUF	;END OF DISPLAY BUFFER -1.
	MOVEI 1↔AOS 1↔DAC(1)			;TEXT OPCODE IS 1, SO
	HRLI 1,1(1)↔MOVS 1↔BLT @ENDBUF		;FILL BUFFER WITH 1'S.
	DZM IGNORE↔DZM SIZBRT↔POP1J

SUBR(DPYOUT)
	CDR 1,DPYPTR↔AOS 1
	SUB 1,BEGBUF↔DAC 1,SIZBUF		;BUFFER SIZE FOR UPGIOT.
	LAC ARG1↔DPB[POINT 4,.+1,12]		;GLASS NUMBER.
	UPGIOT BEGBUF↔POP1J
;------------------------------------------------------------------------------
SUBR(DPYBIG)					;REMEMBER THE NEW SIZE.
	LAC ARG1↔DPB[POINT 3,SIZBRT,27]↔POP1J
SUBR(DPYBRT)					;REMEMBER THE NEW BRIGHTNESS.
	LAC ARG1↔DPB[POINT 3,SIZBRT,24]↔POP1J
SUBR(RIVECT)					;RELATIVE INVISIBLE VECTOR.
	SKIPA 1,[46]
SUBR(RVECT)					;RELATIVE VISIBLE VECTOR.
	MOVEI 1,6↔GO AVECT+1
SUBR(AIVECT)					;ABSOLUTE INVISIBLE VECTOR.
	SKIPA 1,[146]
SUBR(AVECT)					;ABSOLUTE VISIBLE VECTOR.
	MOVEI 1,106↔SKIPGE IGNORE↔POP2J		;OPCODE-FIELD
	LAC ARG2↔DPB[POINT 11,1,10]		;X-FIELD.
	LAC ARG1↔DPB[POINT 11,1,21]		;Y-FIELD.
	IOR 1,SIZBRT↔DZM SIZBRT↔LAC 1		;SIZE & BRIGHTNESS FIELDS.
	AOS 1,DPYPTR↔DAC(1)			;STORE III-COMMAND INTO DPYBUF.
	HRLI 1,700↔DAC 1,DPYPTR			;UPDATE DPY POINTER.
	MOVEI(1)↔CAML ENDBUF↔SETOM IGNORE	;TEST FOR BUFFER OVERFLOW.
	POP2J
SUBR(DPYSTR)
	MOVEI 440700↔DIP ARG1			;BYTE POINTER INTO STACK.
	ILDB ARG1↔JUMPE POP1J.			;FETCH CHR EXIT NULL.
	CALL(DTYO,0)↔GO DPYSTR+2
SUBR(DTYO)
	LAC ARG1↔IDPB DPYPTR			;PACK A CHARACTER INTO DPYBUF.
	CDR DPYPTR↔CAML ENDBUF↔SETOM IGNORE	;CHECK FOR BUFFER OVERFLOW.
	POP1J
;------------------------------------------------------------------------------
	EXTERN BLKCNT,VCUT,HISTO,FILM,HISTOG
SUBR(CROP)--------------------------------------------------------
BEGIN CROP
	LAC 1,OX↔LAC MAG↔FMP SX↔FSB 1,0↔DAC 1,SOX
	LAC 1,OY↔LAC MAG↔FMP SY↔FSB 1,0↔DAC 1,SOY

	LAC 1,OX↔LAC MAG↔FMP[155.0]↔FSB 1,0
	CAMG 1,[-504.0]↔LAC 1,[-504.0]↔DAC 1,XL
	LAC 1,OX↔LAC MAG↔FMP[155.0]↔FAD 1,0
	CAML 1,[ 504.0]↔LAC 1,[504.0]↔DAC 1,XH

	LAC 1,OY↔LAC MAG↔FMP[115.0]↔FSB 1,0
	CAMG 1,[-378.0]↔LAC 1,[-378.0]↔DAC 1,YL
	LAC 1,OY↔LAC MAG↔FMP[115.0]↔FAD 1,0
	CAML 1,[ 378.0]↔LAC 1,[378.0]↔DAC 1,YH

	POP0J
BEND;12/20/72-----------------------------------------------------
;AI(X,Y). AV(X,Y).
SUBR(AI)X,Y ------------------------------------------------------
BEGIN AI
	LAC ARG2↔FMP MAG↔FAD SOX↔DAC XXX
	LAC ARG1↔FMP MAG↔FAD SOY↔DAC YYY
	DZM AIVFLG↔POP2J
BEND;12/20/72-----------------------------------------------------

	AIVFLG:0
SUBR(AV)X,Y
BEGIN AV ;---------------------------------------------------------------------
	LAC XXX↔DAC X1↔LAC ARG2↔FMP MAG↔FAD SOX↔DAC XXX↔DAC X2
	LAC YYY↔DAC Y1↔LAC ARG1↔FMP MAG↔FAD SOY↔DAC YYY↔DAC Y2
	CALL(CLIP,X1,Y1,X2,Y2)↔JUMPE 1,[DZM AIVFLG↔POP2J]	;EDGE OUTSIDER.
	CAIN 1,1↔GO[
	SKIPN AIVFLG↔GO[
	SETOM AIVFLG↔GO L1+1]↔GO L2]
L1:	DZM AIVFLG
	FIXX 6,↔FIXX 7,↔CALL(AIVECT,6,7)
L2:	FIXX 8,↔FIXX 9,↔CALL(AVECT,8,9)
	POP2J
	DECLARE{X1,Y1,X2,Y2}
BEND;12/20/72-----------------------------------------------------

;COLUMN INTO X-COORDINATE.
SUBR(GETXY)VERTEX-------------------------------------------------
BEGIN GETXY; GET DISPLAY COORDINATES FROM ROW-COL COORDINATES.
;RETURN VALUES IN STACK.

;COLUMN INTO X-COORDINATE.
	LAC 1,ARG1↔PUSH P,(P)	;COPY PC.
	COL 0,1
	SUBI =144*=64↔FSC 225↔DAC 0,ARG2		;DPY X.

;ROW INTO Y-COORDINATE.
	ROW 2,1
	MOVEI =108*=64↔SUB 0,2↔FSC 225↔DAC 0,ARG1	;DPY Y.
	POP0J

BEND;1/4/73-------------------------------------------------------
;CLIP(X1,Y1,X2,Y2).	2D CLIPPER.
DECLARE{AAA,BBB,CCC,FLGO,FLGZ,AXH,AXL,BYH,BYL,QNE,QNW,QSW,QSE}
SUBR(CLIP)--------------------------------------------------------
; FLG ← CLIP(X1,Y1,X2,Y2) RETURN TRUE WHEN PORTION IS VISIBLE.
BEGIN CLIP
	ACCUMULATORS{X1,Y1,X2,Y2,PDL}
	PTR←13

;PICK 'EM UP;
	LAC X1,ARG4↔LAC Y1,ARG3
	LAC X2,ARG2↔LAC Y2,ARG1
	MOVEI PTR,PDL-1

;SET NSEW BITS.
	SETZB 1
	CAMLE Y1,YH↔TRO 8↔CAMLE Y2,YH↔TRO 1,8;	NORTH.
	CAMGE Y1,YL↔TRO 4↔CAMGE Y2,YL↔TRO 1,4;	SOUTH.
	CAMLE X1,XH↔TRO 2↔CAMLE X2,XH↔TRO 1,2;	EAST.
	CAMGE X1,XL↔TRO 1↔CAMGE X2,XL↔TRO 1,1;	WEST.

;EASY OUTSIDER EDGE.
	TRNE 0,(1)↔GO [OUTSIDE: SETZ 1,↔POP4J]

;EASY INSIDER VERTICES.
	JUMPE 0,[PUSH PTR,X1↔PUSH PTR,Y1↔GO .+1]
	JUMPE 1,[PUSH PTR,X2↔PUSH PTR,Y2↔GO .+1]
	DEFINE DONE{CAMN PTR,[XWD 4,PDL+3]↔GO L}
	CAMN PTR,[XWD 4,PDL+3]↔GO[MOVEI 1,1↔GO L+1]

;COMPUTE EDGE COEFFICIENTS.
	LAC Y1↔FSBR Y2↔DAC AAA
	LAC X2↔FSBR X1↔DAC BBB
	LAC X2↔FMPR Y1↔MOVNM CCC
	LAC X1↔FMPR Y2↔FADRM CCC

;PARTIAL PRODUCTS.
	LAC AAA↔FMPR XH↔DAC AXH
	LAC AAA↔FMPR XL↔DAC AXL
	LAC BBB↔FMPR YH↔DAC BYH
	LAC BBB↔FMPR YL↔DAC BYL

;CORNER Q'S.
	SETOM FLGO↔DZM FLGZ
	LAC AXH↔FADR BYH↔FADR CCC↔DAC QNE↔ANDM FLGO↔IORM FLGZ
	LAC AXL↔FADR BYH↔FADR CCC↔DAC QNW↔ANDM FLGO↔IORM FLGZ
	LAC AXL↔FADR BYL↔FADR CCC↔DAC QSW↔ANDM FLGO↔IORM FLGZ
	LAC AXH↔FADR BYL↔FADR CCC↔DAC QSE↔ANDM FLGO↔IORM FLGZ

;HARD OUTSIDER CASES.
	SKIPGE FLGO↔GO OUTSIDE
	SKIPL  FLGZ↔GO OUTSIDE
	;2D CLIPPER continued.
;NORTH BORDER CROSSING.
	LAC QNE↔XOR QNW↔SKIPL↔GO L2
	LAC Y1↔CAMGE Y2↔LAC Y2↔CAMG YH↔GO L2
	LAC BYH↔FADR CCC↔MOVNS↔FDVR AAA↔PUSH PTR,
	LAC YH↔PUSH PTR,
	DONE

;SOUTH BORDER CROSSING.
L2:	LAC QSE↔XOR QSW↔SKIPL↔GO L3
	LAC Y1↔CAMLE Y2↔LAC Y2↔CAML YL↔GO L3
	LAC BYL↔FADR CCC↔MOVNS↔FDVR AAA↔PUSH PTR,
	LAC YL↔PUSH PTR,
	DONE

;EAST BORDER CROSSING.
L3:	LAC QSE↔XOR QNE↔SKIPL↔GO L4
	LAC X1↔CAMGE X2↔LAC X2↔CAMG XH↔GO L4
	LAC XH↔PUSH PTR,
	LAC AXH↔FADR CCC↔MOVNS↔FDVR BBB↔PUSH PTR,
	DONE

;WEST BORDER CROSSING.
L4:	LAC QSW↔XOR QNW↔SKIPL↔GO L5
	LAC X1↔CAMLE X2↔LAC X2↔CAML XL↔GO L5
	LAC XL↔PUSH PTR,
	LAC AXL↔FADR CCC↔MOVNS↔FDVR BBB↔PUSH PTR,
	DONE

;STRANGE EXIT - NSEW BIT MARKING & EDGE COEF ARE INCONSISTENT.
L5:	OUTSTR[ASCIZ/2D CLIPPER FALL THRU !
/]↔	GO OUTSIDER

;VISIBLE PORTION EXIT.
L:	SETO 1,
	POP4J
	LIT
BEND;12/20/72-----------------------------------------------------
SUBR(STADPY).		STATUS DISPLAY.
BEGIN STADPY;-----------------------------------------------------
	EXTERN QIMAGE
	SKIPN FLGIII↔POP0J
	CALL(DPYSET,DPYBUF)
	CALL(DPYBIG,[2])↔CALL(DPYBRT,[2])
	DX ←  =100
	DY ← -=60
;FILM NAME AND IMAGE SEQUENCE NUMBER.
	CALL(AIVECT,[=320+DX],[=502+DY])
	CALL(DPYSTR,[[ASCIZ/IMAGE/]])
	CALL(AIVECT,[=320+DX],[=477+DY])
	CALL(DPYSTR,[FNAME])↔EXTERN FNAME
	SETZ↔SKIPE 1,QIMAGE↔NCNT 0,1
	LAC 1,0↔CALL(DECDPY)

;NUMBER OF NODES IN USE.
	CALL(AIVECT,[=160+DX],[=502+DY])
	CALL(DPYSTR,[[ASCIZ/NODES/]])
	CALL(AIVECT,[=170+DX],[=477+DY])
	LAC 1,BLKCNT↔CALL(DECDPY)

;CUT THRESHOLD OF MOST RECENT LEVEL.
	CALL(AIVECT,[=240+DX],[=502+DY])
	CALL(DPYSTR,[[ASCIZ/LEVEL/]])

	CALL(AIVECT,[=220+DX],[=477+DY])
	SETZ 10,↔LAC 1,FILM
	SON 1,1↔JUMPE 1,.+5
	SON 1,1↔JUMPE 1,.+3
	CW 1,1↔NCNT 10,1↔CALL(OD)
	CALL(DPYOUT,[10])
	POP0J
BEND STADPY; BGB 21 JANUARY 1973 ---------------------------------

SUBR(DPYIMG)IMG		;DISPLAY AN IMAGE.
BEGIN DPYIMG;-----------------------------------------------------
	SKIPN FLGIII↔POP0J
	CALL(STADPY)
	CALL(DPYBLK)
	CALL(DPYSET,DPYBUF)
	SKIPN 1,QIMAGE↑↔GO L2			;FIRST IMAGE.
	SON 1,1↔DAC 1,LEV0#↔DAC 1,LEV1#		;FIRST LEVEL.
L0:	LAC 1,LEV1↔CDR 1,(1)↔DAC 1,LEV1		;CDR-LEVEL-RING.
	SON 1,1↔JUMPE 1,L1A
	DAC 1,PGN0#↔DAC 1,PGN1#			;FIRST POLYGON.
L1:	LAC 1,PGN1↔CDR 1,(1)↔DAC 1,PGN1		;CDR-POLY-RING.
	CALL(DPYGON,1)
	LAC 1,PGN1↔CAME 1,PGN0↔GO L1		;POLY-RING-END.
L1A:	LAC 1,LEV1↔CAME 1,LEV0↔GO L0		;LEVEL-RING-END.
L2:	CALL(DPYOUT,[0])↔POP0J

BEND DPYIMG; BGB 4 DECEMBER 1972 ---------------------------------
WNDFLG:	0
SUBR(ID)	;IDENTIFIER DISPLAY - BGB - 13 DEC 1972.
BEGIN ID;----------------------------------------------------------------------

	JUMPE 10,[
	CALL(DPYSTR,[[ASCIZ/NIL  /]])↔AOS(P)↔POP0J]
	MOVEI 2,"U"
	TESTZ 10,VBIT↔MOVEI 2,"V"
	TESTZ 10,VBIT↔MOVEI 2,"A"
	TESTZ 10,PBIT↔MOVEI 2,"P"
	TESTZ 10,LBIT↔MOVEI 2,"L"
	TESTZ 10,IBIT↔MOVEI 2,"I"
	TESTZ 10,FBIT↔MOVEI 2,"F"
	TESTZ 10,SBIT↔MOVEI 2,"S"

	CALL(DTYO,2)
	MOVEI 7,6↔HRLZM 10,10
	JFFO 10,.+1↔CAIL 11,3↔GO[
	ROT 10,3↔SUBI 11,3↔SOJA 7,.-1]↔HLLZS 10
L:	ROT 10,3↔ADDI 10,60
	CALL(DTYO,10)↔HLLZS 10↔SOJG 7,L
	CALL(DTYO,["   "])
	AOS(P)↔POP0J
BEND;12/13/72-----------------------------------------------------

SUBR(OD)	;OCTAL DISPLAY HALF WORD DISPLAY.
BEGIN ODHALF;------------------------------------------------------------------
	CNT ←← 7 ↔ TAC ←← 8			;CHARACTER COUNTER & TEMPORARY.
	JUMPE TAC,[CALL(DPYSTR,[[ASCIZ/   --- /]])↔POP0J]
	MOVEI CNT,6↔HRLZM TAC,TAC		;SAVE IN LEFT HALF.
	SETOM ZSFLAG#				;SUPPRESS LEADING ZEROES.
L:	ROT TAC,3↔ADDI TAC,60			;FORM ASCII CHARACTER.
	TRNN TAC,17↔GO[
	SKIPE ZSFLAG↔SUBI TAC,20↔GO .+2]	;SUPPRESS LEADING ZEROES.
	DZM ZSFLAG				;NON-ZERO DETECTED.
	CALL(DTYO,TAC)
	HLLZS TAC↔SOJG CNT,L			;ZAP TAC & LOOP.
	CALL(DTYO,[" "])↔POP0J
BEND ODHALF;12/13/72-----------------------------------------------------------

SUBR(DECDPY)NUM		;DECIMAL DISPLAY NUMBER.
BEGIN DECDPY;------------------------------------------------------------------
L1:	JUMPGE 1,.+5
	MOVM 2,1↔CALL(DTYO,["-"])
	LAC 1,2↔IDIVI 1,12			;DIVIDE BY TEN
	PUSH P,2↔SKIPE 1↔PUSHJ P,L1
	POP P,1↔ADDI 1,60↔CALL(DTYO,1)
	POP0J
BEND DECDPY;-------------------------------------------------------------------
SUBR(DPYBLK)NODE.		DISPLAY CONTENTS OF A NODE.
BEGIN DPYBLK;-----------------------------------------------------
	Q←15 ↔ REL←14 ↔	Y←5 ↔ I←6

;WINDOW FRAME
	CALL(DPYSET,DPYBUF)
	SKIPN WNDFLG↔GO[
	  CALL(AIVECT,[-=504],[-=378])
	  CALL(AVECT,[=504],[-=378])
	  CALL(AVECT,[=504],[=378])
	  CALL(AVECT,[-=504],[=378])
	  CALL(AVECT,[-=504],[-=378])↔GO .+1]
	SKIPN Q,QBLK↔GO L3

;DISPLAY BLOCK TYPE LABEL.
	CALL(AIVECT,[=320],[-=315])
		     MOVEI 1,[ASCIZ/EMPTY - /]
	TESTZ Q,FBIT↔MOVEI 1,[ASCIZ/FILM - /]
	TESTZ Q,IBIT↔MOVEI 1,[ASCIZ/IMAGE - /]
	TESTZ Q,LBIT↔MOVEI 1,[ASCIZ/LEVEL - /]  
	TESTZ Q,PBIT↔MOVEI 1,[ASCIZ/POLYGON - /]
	TESTZ Q,SBIT↔MOVEI 1,[ASCIZ/SHAPE - /]  
	TESTZ Q,VBIT↔MOVEI 1,[ASCIZ/VECTOR - /]
L0:	CALL(DPYSTR,1)
L1:	LAC 10,Q↔CALL(ID)↔JFCL
	RELOC REL,Q				;GET RELOCATION BITS.

;DISPLAY NODE CONTENTS.
	SETZ I,↔MOVNI Y,=340
L2:	CALL(AIVECT,[=280],Y)↔SUBI Y,=20↔PUSH  P,[
	[ASCIZ/,. 0  /]↔[ASCIZ/<> 1  /]↔[ASCIZ/   2  /]↔[ASCIZ/∪∩ 3  /]
	[ASCIZ/≤≥ 4  /]↔[ASCIZ/⊂⊃ 5  /]↔[ASCIZ/∨∧ 6  /]↔[ASCIZ/   7  /]](I)
	PUSHJ P,DPYSTR

	CAR 10,0(Q)↔TRNE REL,400⊗9↔CALL(ID)↔CALL(OD)
	CDR 10,0(Q)↔TRNE REL,400  ↔CALL(ID)↔CALL(OD)
	ROT REL,1↔AOS Q↔AOS I↔CAIGE I,8↔GO L2↔SUBI Q,8

;LIGHT UP THE QBLK WHEN IT IS A VECTOR OR A POLYGON.
	TESTZ Q,PBIT↔GO[CALL(DPYBRT,[6])↔CALL(DPYGON,Q)↔GO L3]
	TESTZ Q,SBIT↔GO[CALL(DPYBRT,[6])
		CALL(GETXY,Q)↔CALL(AI)
		CALL(GETXY,Q)↔CALL(AV)↔GO L3]
	TESTZ Q,VBIT↔GO[CALL(DPYBRT,[6])
		CALL(GETXY,Q)↔CALL(AI)↔CCW 1,Q
		CALL(GETXY,1)↔CALL(AV)↔GO L3]
L3:	CALL(DPYBRT,[2])
	CALL(DPYOUT,[1])↔POP0J
BEND;1/25/73------------------------------------------------------
QBLK:	0	↔ INTERN QBLK
SUBR(TIMDPY)PGON	;DISPLAY A POLYGON'S TIME SUCCESSOR.
BEGIN TIMDPY;-----------------------------------------------------

	TDCA↔SETO↔DAC FLG#		;PAST OR FUTURE.
	LAC 1,ARG1↔DAC 1,POLY1#
	TEST 1,PBIT↔POP1J
	PTIME 1,1↔SKIPE FLG↔NTIME 1,1
	SKIPN 1↔POP1J↔DAC 1,POLY2#↔DZM POLY3#
	
;DISPLAY POLYGONS LINKED IN TIME.
	DZM 1↔MOVEI 1↔UPGIOT		;CLEAR DPYBLK.
	CALL(DPYSET,DPYBUF)
	CALL(DPYBRT,[3])
	CALL(DPYBIG,[1])

	CALL(DPYGON,POLY1)
	CALL(DPYGON,POLY2)

	LAC 1,ARG1
	SON 1,1↔DAC 1,V0#
	DZM CNT#
L1:	DAC 1,V1#
	PTIME 2,1↔SKIPE FLG↔NTIME 2,1
	JUMPE 2,L2↔DAC 2,U1#↔DAD 0,2↔CAME 0,POLY2↔DAC 0,POLY3

;DISPLAY LINE SEGMENT BETWEEN TIME LINKED VERTICES.
	CALL(GETXY,V1)↔CALL(AI)
	CALL(GETXY,U1)↔CALL(AV)
	AOS 1,CNT↔CALL(DECDPY)

L2:	LAC 1,V1↔CCW 1,1
	CAME 1,V0↔GO L1
	SKIPE POLY3↔GO[CALL(DPYGON,POLY3)↔GO .+1]
	CALL(DPYBRT,[2])
	CALL(DPYBIG,[2])
	CALL(DPYOUT,[0])
	INCHRW↔CAIN"P"↔GO[CALL(PLOTO)↔GO .+1]
	CALL(DPYIMG)
	POP1J
BEND TIMDPY;BGB 25 APRIL 1973 ------------------------------------
SUBR(DPYHIS)		DISPLAY HISTOGRAM.
BEGIN DPYHIS;-----------------------------------------------------
	X←←10 ↔ Y←←11 ↔ CNT←←14
	SKIPN FLGIII↔POP0J
;COMPUTE THE HISTOGRAM AND DETERMINE WHETHER 4 OR 6 BIT.
	CALL(HISTOG)
	CALL(DPYSET,DPYBUF)
	CALL(DPYBIG,[1])
	SETZ↔MOVEI 1,74↔ADD HISTO(1)↔SUBI 1,4↔SKIPL 1↔GO .-3
	DZM FLGSIX#↔CAIE =62208↔SETOM FLGSIX

;SCALE THE IMAGE TO ITS LARGEST COLUMN.
	SETZ↔HRLZI 1,-77
	CAMGE 0,HISTO(1)↔LAC HISTO(1)↔AOBJN 1,.-2
	MOVE 1,[800.0]↔FSC 233↔FDV 1,0↔DAC 1,SY#

;INITIALIZE HISTO LOOP.
	SETZ CNT,
	HRREI X,=511↔HRREI Y,-=404
	CALL(AIVECT,X,Y)↔MOVNS X
	CALL(AVECT,X,Y)

L1:	SKIPN FLGSIX↔GO[TRNE CNT,3↔GO L2↔GO .+1]
	LAC Y,HISTO(CNT)↔FSC Y,233↔FMP Y,SY↔FIXX Y,
	SUBI Y,=400
L2:	CALL(AVECT,X,Y)
	TRNE CNT,3↔GO L3
;INTENSITY LEVEL NUMERAL.
	HRREI 0,-=440↔SUBI X,10↔CALL(AIVECT,X,0)
	LAC CNT↔LSHC -3↔SKIPE↔IORI "0"↔IORI " "
	LSH 4↔LSHC 3
	IORI "0"↔ROT 0,-16↔IORI 1
	AOS 1,DPYPTR↔DAC(1)
;PEC CENT AT THIS LEVEL NUMERAL.
	HRREI 0,-=465↔CALL(AIVECT,X,0)↔ADDI X,10
	LAC HISTO+0(CNT)↔ADD HISTO+1(CNT)
	ADD HISTO+2(CNT)↔ADD HISTO+3(CNT)
	IMULI =1000↔IDIVI =62208↔ADDI 5↔IDIVI =10
	JUMPE L4↔IDIVI =10
	ROT 1,-4
	SKIPE↔IORI "0"↔IORI " "
	LSH 3↔LSHC 4↔IORI "0"↔LSH 16↔IORI " %"
	LSH 8↔IORI 1↔AOS 1,DPYPTR↔DAC(1)
L4:	CALL(AIVECT,X,Y)
;ADVANCE.
L3:	ADDI X,20
	CALL(AVECT,X,Y)
	AOS CNT↔CAIE CNT,100↔GO L1
	HRREI -=400↔CALL(AVECT,X,0)
	CALL(DPYBIG,[2])↔CALL(DPYOUT,[0])↔POP0J
BEND DPYHIS; BGB 8 DECEMBER 1972 ---------------------------------
SUBR(DPYGON)PGON	DISPLAY POLYGON.
BEGIN DPYGON;-----------------------------------------------------

;FIRST EDGE/VERTEX ABSOLUTE INVISIBLE VECTOR.
	LAC 1,ARG1
	HRRE 4(1)↔MOVMM↔CAMGE PCUT↑↔POP1J	;POLY SIDAL CUT.
	SON 2,1
	LAC 1,2
	JUMPE 1,POP1J.
	LAC 2(1)↔JUMPE POP1J.
L0:	DAC 1,E0#↔DAC 1,V#
	CALL(GETXY,1)↔PUSHJ P,AI

;FOLLOW AROUND THE POLYGON WITH ABS VISIBLE VECTORS.
L1:	LAC 1,V↔CDR 1,0(1)↔DAC 1,V
	CALL(GETXY,1)↔LAC 1,V
	CNTRST 0,1↔MOVMS
	CAMG 0,VCUT↔GO[PUSHJ P,AI↔GO .+2]↔PUSHJ P,AV
	LAC 1,V↔CAME 1,E0↔GO L1
	POP1J
BEND DPYGON; BGB 4 DECEMBER 1972 ---------------------------------
END